(in-package "ACL2") 
(include-book "rule-creator")
(include-book "grid")
(include-book "avl-utils")
(include-book "state-list-utils")
(include-book "wolfram-code-utils")
;;;Module for updating a lifelike or elementary cellular automata.
;;;Exports a single function. "grid-step".


;;Get all cells adjoining a cell c
(defun get-lifelike-neighbor-list* (c)
    (list (cell (cell-x c) (1- (cell-y c)))
          (cell (cell-x c) (1+ (cell-y c)))
          (cell (1+ (cell-x c)) (cell-y c))
          (cell (1+ (cell-x c)) (1- (cell-y c)))
          (cell (1+ (cell-x c)) (1+ (cell-y c)))
          (cell (1- (cell-x c)) (cell-y c))
          (cell (1- (cell-x c)) (1- (cell-y c)))
          (cell (1- (cell-x c)) (1+ (cell-y c)))))

;;accumulator function for getting count of live cells
;; cells: those cells yet to be processed
;; acc-count: count of live cells in processed cells
(defun get-live-cell-count-acc* (grid cells acc-count)
  (if (endp cells)
    acc-count
    (if (lifelike-grid-get-cell grid (car cells))
      (get-live-cell-count-acc* grid (cdr cells) (1+ acc-count))
      (get-live-cell-count-acc* grid (cdr cells) acc-count))))


;;Gets  count of all live cells in cells
(defun get-live-cell-count* (grid cells)
  (get-live-cell-count-acc* grid cells 0))

;;Gets count of all live cells that are neighbors of cell
(defun get-lifelike-neighbors-live-count* (grid cell)
    (get-live-cell-count* grid (get-lifelike-neighbor-list* cell)))


;;Accumulator function for get-combined-lifelike-cells*
;;  cells: List of cells yet to be processed
;;  grid: neighbors of cells already processed
;;Returns grid.
(defun get-combined-lifelike-neighbor-cells-as-grid-acc* (cells grid)
  (if (endp cells)
    grid
    (get-combined-lifelike-neighbor-cells-as-grid-acc*
      (cdr cells)
        (lifelike-grid-set-multiple-cells grid
          (get-lifelike-neighbor-list* (car cells)) t))))

;;Get all cells which are neighbors of cells in cells, but aren't in cells themselves.
(defun get-combined-lifelike-neighbor-cells* (cells)
  (let* ((neighbors-as-grid 
            (get-combined-lifelike-neighbor-cells-as-grid-acc*
              cells (empty-lifelike-grid)))
          (neighbors-as-grid-minus-cells 
            ;remove all cells in "cells"
            (lifelike-grid-set-multiple-cells neighbors-as-grid cells 
              nil)))
        (nested-avl-flatten-to-cells neighbors-as-grid-minus-cells)))

;;Accumulator function used by get-suriving-cells*
;;  all-live-cells: live cells yet to be processed
;;  new-grid: grid containing the cells processed which should be in the next
;;    generation
;;  Returns new-grid when all-live-cells is empty
(defun accumulate-surviving-cells* (grid rules all-live-cells new-grid)
    (if (endp all-live-cells)
        new-grid
        (let* ((curr-cell (car all-live-cells))
                (rest-cells (cdr all-live-cells))
                (should-live (not (is-state-present 
                    (get-lifelike-neighbors-live-count* grid curr-cell)
                    (ruleset-death-states rules)))))
            (if should-live
                (accumulate-surviving-cells* grid rules rest-cells 
                    (lifelike-grid-set-cell new-grid curr-cell t))
                (accumulate-surviving-cells* grid rules rest-cells
                    new-grid)))))


;;Compute which of the live cells associated with a grid should
;;continue to the next iteration
;;Returns the grid with dead cells removed.
;;  all-live-cells: flattened list of every cell alive in the grid
(defun get-surviving-cells* (grid rules all-live-cells)
    (accumulate-surviving-cells* grid rules all-live-cells (empty-lifelike-grid)))

;;Accumulator function: Given a list of cells, live-cell-neighbors,
;;that are currently dead, adds all those that should be born to 
;;grid-acc and then return grid-acc
;; grid: the grid to use to determine what cells should be born
;; rules: the rules structure to use
;; live-cell-neighbors: the list of cells to consider for birth
;; grid-acc: the grid to add new cells to and ultimately return.
;;    This must be separate from grid, since the new cells shouldn't
;;    affect old ones.
(defun accumulate-born-cells* (grid rules live-cell-neighbors 
                                grid-acc)
  (if (endp live-cell-neighbors)
    grid-acc
    (let* ((curr-cell (car live-cell-neighbors))
            (rest-cells (cdr live-cell-neighbors))
            (should-be-born (is-state-present 
                (get-lifelike-neighbors-live-count* grid curr-cell)
                (ruleset-birth-states rules))))
        (if should-be-born
            (accumulate-born-cells* grid rules rest-cells
                (lifelike-grid-set-cell grid-acc curr-cell t))
         
            (accumulate-born-cells* grid rules rest-cells 
                grid-acc)))))

;;Performs one step of the automata for
;;a lifelike ruleset.
;;Returns a list with
;; 1. the new grid
;; 2. the new grid as a flat list.
(defun lifelike-grid-step* (grid rules)
    (let* ((all-live-cells (nested-avl-flatten-to-cells grid))
           (all-neighbors (get-combined-lifelike-neighbor-cells* 
              all-live-cells))
           (grid-after-death
                (get-surviving-cells* grid rules all-live-cells))
           (new-grid (accumulate-born-cells* grid rules
              all-neighbors grid-after-death))
           (new-grid-flattened (nested-avl-flatten-to-cells new-grid)))
      (list new-grid new-grid-flattened)))



;;Given the life status of a position, the position to its left
;;and the position to its right, compute whether that cell should
;;be alive and update the grid stored in acc-grid-changes
;;  l/rpos-alive: whether the position's neighbors on the left and
;;    right are alive'
;;  pos: the integer position under consideration
;;  acc-grid-changes: grid in the process of being updated.
;;    updated if cell should be born, otherwise unused.
(defun update-dead-cell* (lpos-alive pos-alive rpos-alive pos 
        wolf-table acc-grid-changes)
    (let* ((sit-number (get-situation-number-explicit 
            lpos-alive pos-alive rpos-alive)))
        (if (check-situation wolf-table sit-number)
                (elementary-grid-set acc-grid-changes pos t)
                acc-grid-changes)))

;;Computes the next step of an elementary CA from 
;;  grid: the current grid
;;  live-poses: all live cells in the current grid not yet processed.
;;      Dead cells to process are computed from these.
;;  wolf-table: The wolfram table representing the wolfram code used
;;  new-grid: elementary grid containing the cells which have been processed
;;            that are alive in the next generation

;;Returns new-grid after all cells have been processed.
(defun accumulate-elementary-cells* (grid live-poses wolf-table new-grid)
    (if (endp live-poses)
        new-grid
        (let* ((live-pos (car live-poses))
                (rest-live-poses (cdr live-poses))

                (left-pos (1- live-pos))
                (right-pos (1+ live-pos))

                (left-pos-alive (elementary-grid-get grid left-pos))
                (right-pos-alive (elementary-grid-get grid right-pos))
                (curr-pos-situation-number (get-situation-number-explicit
                    left-pos-alive t right-pos-alive))
                (should-curr-pos-stay (check-situation wolf-table 
                    curr-pos-situation-number))

                ;Update-center handles the current element
                ;and update-left and update-right handle the
                ;left and right elements if they are
                ;dead. Each of them returns a (<grid> <changeset>)
                ;that is fed into the next one.
                (update-center (if should-curr-pos-stay
                                      (elementary-grid-set 
                                                new-grid live-pos t)
                                      new-grid))
                (update-left (if left-pos-alive
                                update-center
                                (let* ((leftleft (1- left-pos))
                                       (leftleft-alive 
                                        (elementary-grid-get grid 
                                            leftleft)))
                                    (update-dead-cell* leftleft-alive 
                                        left-pos-alive t left-pos 
                                        wolf-table update-center))))
                (update-right (if right-pos-alive
                                update-left
                                (let* ((rightright (1+ right-pos))
                                       (rightright-alive 
                                        (elementary-grid-get grid 
                                            rightright)))

                                  ;If the far right position is alive, don't update:
                                  ;we'll handle this when updating the far right position
                                  (if rightright-alive
                                    update-left
                                    (update-dead-cell* t right-pos-alive
                                        rightright-alive right-pos
                                        wolf-table update-left))))))
            (accumulate-elementary-cells* grid rest-live-poses
                wolf-table update-right))))

;;Performs one step of the automata for
;;an elementary ruleset.
;;Returns the new grid and a flat list of all the live positions in the new grid
(defun elementary-grid-step* (grid rules)
  (let* ((wolfram-table (parse-wolfram-code (ruleset-wolfram-code rules))) ;TODO: cache this in ruleset
         (new-grid (accumulate-elementary-cells* grid (flatten-elementary-grid grid)
           wolfram-table (empty-elementary-grid))))
      (list new-grid (elementary-grid-get-all-live-cells new-grid))))

;;Overall grid step function: checks ruleset to
;;determine what rule function to call,
;;then performs one step of that.
;;Returns a list containing:
;; 1. the new grid
;; 2. a flattened list of all cells in the new grid
(defun grid-step (grid rules)
    (let* ((ruletype (ruleset-rule-type rules)))
        (cond ((equal ruletype "lifelike")
                (lifelike-grid-step* grid rules))
              ((equal ruletype "elementary")
                (elementary-grid-step* grid rules))
              (t "error"))))

;(defconst *gol*
;	(generate-lifelike-rules* 
;		(list 0 1 4 5 6 7 8) (list 3)))
        
;(defconst *h-bar*
;	(lifelike-grid-set (lifelike-grid-set 
;		(lifelike-grid-set (empty-lifelike-grid)
;		 0 0 t) 1 1 t) -1 -1 t))